home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / GFXFX2.ZIP / 3D_TMAP3.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-02-14  |  4.3 KB  |  121 lines
  1.  
  2. program texturemapping; { 3D_TMAP3.PAS }
  3. { Gouraud dhaded texture-mapping, by Jeroen Bouwens }
  4. uses u_vga,u_ffpcx,u_pal,u_3d,u_kb;
  5. const
  6.   picfile='gfxfx2.pcx';
  7.   picsize=270*180;
  8.   nofpoints=8; { cube has 8 corners }
  9.   nofplanes=12; { 2 triangles/face, 6 faces = 12 triangles }
  10.   points:array[1..nofpoints,0..2] of integer=(
  11.     (10,10,10),(-10,10,10),(-10,-10,10),(10,-10,10),
  12.     (10,10,-10),(-10,10,-10),(-10,-10,-10),(10,-10,-10));
  13.   planes:array[1..nofplanes,0..2] of integer=(
  14.     (1,2,6),(1,6,5),(2,3,7),(2,7,6),(3,4,8),(3,8,7),
  15.     (4,1,5),(4,5,8),(3,2,1),(3,1,4),(5,6,7),(5,7,8));
  16.  
  17. var
  18.   ut,vt:array[1..nofplanes,0..2] of word;
  19.   picture:pointer;
  20.  
  21. procedure initialize; { load texturemap picture and set uv-coords }
  22. var pal:pal_type; i:word; j,k:byte;
  23. begin
  24.   setvideo($13); { set graphics mode }
  25.   fillchar(pal,sizeof(pal),0); setpal(pal); { set all colors to black }
  26.   i:=pcx_load(picfile,vidptr,pal); { drop pcx file on screen }
  27.   getmem(picture,picsize); { reserve memory for texture map }
  28.   for j:=0 to 179 do for i:=0 to 269 do { copy picture to memory }
  29.     mem[seg(picture^):ofs(picture^)+270*j+i]:=mem[$a000:320*j+i];
  30.   cls(vidptr,320*200); { clear screen }
  31.   setpal(pal); { set picture palette }
  32.  
  33.   k:=1; { define the uv-coordinates for every point in every surface }
  34.   for i:=0 to 1 do for j:=0 to 2 do begin
  35.     ut[k,0]:=j*89; vt[k,0]:=i*89;
  36.     ut[k,1]:=j*89+88; vt[k,1]:=i*89;
  37.     ut[k,2]:=j*89+88; vt[k,2]:=i*89+88;
  38.     inc(k);
  39.     ut[k,0]:=j*89; vt[k,0]:=i*89;
  40.     ut[k,1]:=j*89+88; vt[k,1]:=i*89+88;
  41.     ut[k,2]:=j*89; vt[k,2]:=i*89+88;
  42.     inc(k);
  43.   end;
  44. end;
  45.  
  46. procedure rotate_object;
  47. const
  48.   depth=300;
  49.   xst=1; yst=2; zst=2;
  50. var
  51.   xa,ya,za:array[1..nofpoints] of real; { rotated object coords }
  52.   bx,by,bz:array[1..nofpoints] of integer; { 2d coords }
  53.   magntab:array[0..255] of byte; { magnification table }
  54.   virscr:pointer;
  55.   relx1,relx2,relz1,relz2,rely1,rely2:real;
  56.   vx,vy,vz,ux,uy,uz,ul:real;
  57.   ll:real;
  58.   xt,yt,zt:real;
  59.   costheta:real;                { angle between lightsource and plane-normal }
  60.   negmag,posmag,                                            { zoom constants }
  61.   lx,ly,lz:integer;                                     { lightsource coords }
  62.   phix,phiy,phiz,                                 { angles of rotated object }
  63.   surfcol,                                     { surface illumination factor }
  64.   magidx,i,j,k:byte;
  65. begin
  66.   for i:=0 to 255 do magntab[i]:=round(sin(i*4*pi/255)*20)+22;
  67.   lx:=0; ly:=0; lz:=15; { light source coordinates }
  68.   ll:=sqrt(lx*lx+ly*ly+lz*lz);
  69.   phix:=0; phiy:=0; phiz:=0;
  70.   magidx:=0;
  71.   getmem(virscr,320*200); { reserve memory for virtual screen }
  72.   destenation:=virscr; destseg:=seg(destenation^); { set new destenation }
  73.   repeat
  74.     for i:=1 to nofpoints do begin
  75.       xt:=points[i,0]; yt:=points[i,1]; zt:=points[i,2]; { get original }
  76.       rrotate(xt,yt,zt,phix,phiy,phiz); { rotate it }
  77.       bz[i]:=15+round(zt/1.2);
  78.       zt:=zt+60;
  79.       xa[i]:=xt; ya[i]:=yt; za[i]:=zt-20;
  80.       bx[i]:=160+round((xt*depth)/zt); { convert to 2d }
  81.       by[i]:=100+round((yt*depth*0.8333)/zt);
  82.     end;
  83.  
  84.     cls(virscr,320*200);
  85.     for i:=1 to nofplanes do
  86.       if not checkfront(bx[planes[i,0]],by[planes[i,0]],
  87.           bx[planes[i,1]],by[planes[i,1]],
  88.           bx[planes[i,2]],by[planes[i,2]]) then begin
  89.         gouraudtexture(bx[planes[i,0]],by[planes[i,0]],ut[i,0],vt[i,0],bz[planes[i,0]],
  90.           bx[planes[i,1]],by[planes[i,1]],ut[i,1],vt[i,1],bz[planes[i,1]],
  91.           bx[planes[i,2]],by[planes[i,2]],ut[i,2],vt[i,2],bz[planes[i,2]],
  92.           seg(picture^),ofs(picture^),270);
  93.       end;
  94.     flip(virscr,vidptr,320*200); { display picture }
  95.  
  96.     k:=1; inc(magidx,5);
  97.     negmag:=45-magntab[magidx];
  98.     posmag:=45+magntab[magidx];
  99.     for i:=0 to 1 do for j:=0 to 2 do begin
  100.       ut[k,0]:=j*89+negmag; vt[k,0]:=i*89+negmag;
  101.       ut[k,1]:=j*89+posmag; vt[k,1]:=i*89+negmag;
  102.       ut[k,2]:=j*89+posmag; vt[k,2]:=i*89+posmag;
  103.       inc(k);
  104.       ut[k,0]:=j*89+negmag; vt[k,0]:=i*89+negmag;
  105.       ut[k,1]:=j*89+posmag; vt[k,1]:=i*89+posmag;
  106.       ut[k,2]:=j*89+negmag; vt[k,2]:=i*89+posmag;
  107.       inc(k);
  108.     end;
  109.  
  110.     inc(phix,xst); inc(phiy,yst); inc(phiz,zst); { increase angles }
  111.   until keypressed;
  112.   freemem(virscr,320*200);
  113. end;
  114.  
  115. begin
  116.   initialize;
  117.   rotate_object;
  118.   freemem(picture,picsize);
  119.   setvideo(u_lm);
  120. end.
  121.